home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-prof.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-07  |  6.2 KB  |  279 lines
  1. /*  pl-prof.c,v 1.14 1995/09/08 14:27:28 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: program profiler
  8. */
  9.  
  10. #include "pl-incl.h"
  11.  
  12. #ifdef O_PROFILE
  13.  
  14. #ifdef TIME_WITH_SYS_TIME
  15. #include <sys/time.h>
  16. #include <time.h>
  17. #else
  18. #ifdef HAVE_SYS_TIME_H
  19. #include <sys/time.h>
  20. #else
  21. #include <time.h>
  22. #endif
  23. #endif
  24.  
  25. forwards void profile(int);
  26.  
  27. struct itimerval value, ovalue;        /* itmer controlling structures */
  28.  
  29. #ifdef HAVE_SIGACTION
  30. static struct sigaction osigaction;
  31. #endif
  32.  
  33. #ifndef SA_NOMASK
  34. #define SA_NOMASK 0
  35. #endif
  36. #ifndef SA_RESTART
  37. #define SA_RESTART 0
  38. #endif
  39.  
  40. static bool
  41. startProfiler(int how)
  42. {
  43. #ifdef HAVE_SIGACTION
  44.   struct sigaction action;
  45.  
  46.   memset((char *) &action, 0, sizeof(action));
  47.   action.sa_handler  = profile;
  48.   action.sa_flags    = SA_NOMASK|SA_RESTART;
  49.  
  50.   sigaction(SIGPROF, &action, &osigaction);
  51. #else
  52.   pl_signal(SIGPROF, profile);
  53. #endif
  54.  
  55.   value.it_interval.tv_sec  = 0;
  56.   value.it_interval.tv_usec = 1;
  57.   value.it_value.tv_sec  = 0;
  58.   value.it_value.tv_usec = 1;
  59.   
  60.   if (setitimer(ITIMER_PROF, &value, &ovalue) != 0)
  61.     return warning("Failed to start interval timer: %s", OsError());
  62.   LD->statistics.profiling = how;
  63.  
  64.   succeed;
  65. }
  66.  
  67. void
  68. stopItimer(void)
  69. { value.it_interval.tv_sec  = 0;
  70.   value.it_interval.tv_usec = 0;
  71.   value.it_value.tv_sec  = 0;
  72.   value.it_value.tv_usec = 0;
  73.   
  74.   if ( LD->statistics.profiling == NO_PROFILING )
  75.     return;
  76.   if (setitimer(ITIMER_PROF, &value, &ovalue) != 0)
  77.   { warning("Failed to stop interval timer: %s", OsError());
  78.     return;
  79.   }
  80. }
  81.  
  82. static bool
  83. stopProfiler()
  84. { if ( LD->statistics.profiling == NO_PROFILING )
  85.     succeed;
  86.  
  87.   stopItimer();
  88.   LD->statistics.profiling = NO_PROFILING;
  89. #ifdef HAVE_SIGACTION
  90.   sigaction(SIGPROF, &osigaction, NULL);
  91. #else
  92. #ifdef _AIX
  93.   pl_signal(SIGPROF, SIG_IGN);
  94. #else
  95.   pl_signal(SIGPROF, SIG_DFL);
  96. #endif
  97. #endif
  98.  
  99.   succeed;
  100. }
  101.  
  102. word
  103. pl_profile(term_t old, term_t new)
  104. { int prof = LD->statistics.profiling;
  105.  
  106.   TRY(setInteger(&prof, "profile", old, new));
  107.   if ( prof == LD->statistics.profiling )
  108.     succeed;
  109.   LD->statistics.profiling = prof;
  110.   switch(prof)
  111.   { case NO_PROFILING:
  112.     return stopProfiler();
  113.     case CUMULATIVE_PROFILING:
  114.     case PLAIN_PROFILING:
  115.     if (LD->statistics.profiling != NO_PROFILING)
  116.     { stopProfiler();
  117.       pl_reset_profiler();
  118.     }
  119.     return startProfiler(prof);
  120.     default:
  121.     warning("$profile/2: illegal second argument");
  122.     fail;
  123.   }
  124. }
  125.     
  126. word
  127. pl_profile_count(term_t head, term_t calls, term_t prom)
  128. { Procedure proc;
  129.   Definition def;
  130.   int pm;
  131.  
  132.   if ( !get_procedure(head, &proc, 0, GP_FIND) )
  133.     return warning("profile_count/3: No such predicate");
  134.  
  135.   def = proc->definition;
  136.   pm  = (LD->statistics.profile_ticks == 0 ? 0 :
  137.                          ((1000 * def->profile_ticks) /
  138.                           LD->statistics.profile_ticks));
  139.   
  140.   if ( PL_unify_integer(calls, def->profile_calls+def->profile_redos) &&
  141.        PL_unify_integer(prom, pm) )
  142.     succeed;
  143.  
  144.   fail;
  145. }
  146.  
  147.  
  148. word
  149. pl_profile_box(term_t head,
  150.            term_t calls, term_t redos,
  151.            term_t exits, term_t fails)
  152. { Procedure proc;
  153.   Definition def;
  154.  
  155.   if ( !get_procedure(head, &proc, 0, GP_FIND) )
  156.     return warning("profile_box/5: No such predicate");
  157.   def = proc->definition;
  158.  
  159.   if ( PL_unify_integer(calls, def->profile_calls) &&
  160.        PL_unify_integer(redos, def->profile_redos) &&
  161.        PL_unify_integer(exits, def->profile_calls +
  162.                    def->profile_redos -
  163.                    def->profile_fails) &&
  164.        PL_unify_integer(fails, def->profile_fails) )
  165.     succeed;
  166.  
  167.   fail;
  168. }
  169.  
  170.  
  171. word
  172. pl_reset_profiler(void)
  173. { Module module;
  174.   Procedure proc;
  175.   Symbol sm, sp;
  176.  
  177.   if (LD->statistics.profiling != NO_PROFILING)
  178.     stopProfiler();
  179.  
  180.   for_table(sm, GD->tables.modules)
  181.   { module = (Module) sm->value;
  182.     for_table(sp, module->procedures)
  183.     { proc = (Procedure) sp->value;
  184.  
  185.       proc->definition->profile_calls = 0;
  186.       proc->definition->profile_redos = 0;
  187.       proc->definition->profile_fails = 0;
  188.       proc->definition->profile_ticks = 0;
  189.       clear(proc->definition, PROFILE_TICKED);
  190.     }
  191.   }
  192.   LD->statistics.profile_ticks = 0;
  193.  
  194.   succeed;
  195. }
  196.  
  197. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  198. This function is responsible for collection the profiling statistics  at
  199. run time.  It is called by the UNIX interval timer on each clock tick of
  200. the  machine  (every  20  milli seconds).  If profiling is plain we just
  201. increment the profiling tick of the procedure on top of the stack.   For
  202. cumulative  profiling  we  have  to  scan the entire local stack.  As we
  203. don't want to increment each invokation of recursive  functions  on  the
  204. stack  we  maintain a flag on each function.  This flag is set the first
  205. time the function is found on the stack.  If is is found set the profile
  206. counter will not be incremented.  We do a second pass over the frames to
  207. clear the flags again.
  208. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  209.  
  210. static void
  211. profile(int sig)
  212. { register LocalFrame fr = environment_frame;
  213.  
  214. #if _AIX
  215.   if ( LD->statistics.profiling == NO_PROFILING )
  216.     return;
  217. #endif
  218.  
  219. #if !defined(BSD_SIGNALS) && !defined(HAVE_SIGACTION)
  220.   signal(SIGPROF, profile);
  221. #endif
  222.  
  223.   LD->statistics.profile_ticks++;
  224.  
  225.   if ( gc_status.active )
  226.   { PROCEDURE_garbage_collect0->definition->profile_ticks++;
  227.     return;
  228.   }
  229.  
  230.   if (fr == (LocalFrame) NULL)
  231.     return;
  232.  
  233.   if (LD->statistics.profiling == PLAIN_PROFILING)
  234.   { fr->predicate->profile_ticks++;
  235.     return;
  236.   }
  237.  
  238.   for(; fr; fr = parentFrame(fr) )        /* CUMULATIVE_PROFILING */
  239.   { register Definition def = fr->predicate;
  240.     if ( false(def, PROFILE_TICKED) )
  241.     { set(def, PROFILE_TICKED);
  242.       def->profile_ticks++;
  243.     }
  244.   }
  245.   
  246.   for(fr = environment_frame; fr; fr = parentFrame(fr) )
  247.     clear(fr->predicate, PROFILE_TICKED);
  248. }
  249.  
  250. #else /* O_PROFILE */
  251.  
  252. void
  253. stopItimer()
  254. {
  255. }
  256.  
  257. word
  258. pl_profile(term_t old, term_t new)
  259. { return notImplemented("profile", 2);
  260. }
  261.  
  262. word
  263. pl_profile_count(term_t head, term_t calls, term_t prom)
  264. { return notImplemented("profile_count", 3);
  265. }
  266.  
  267. word
  268. pl_profile_box(term_t head,
  269.            term_t calls, term_t redos, term_t exits, term_t fails)
  270. { return notImplemented("profile_box", 3);
  271. }
  272.  
  273. word
  274. pl_reset_profiler()
  275. { return notImplemented("reset_profile", 0);
  276. }
  277.  
  278. #endif /* O_PROFILE */
  279.